home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1987-03-15 | 3.2 KB | 109 lines
100 REM LISTPER Program. 110 REM Prints a List of Persons 120 REM Copyright (c) 1983 - 1987 by: Melvin O. Duke. 130 DEFINT A-Z 600 REM Titles 610 TITLE$ = "List the Persons File" 620 TITLE$ = TITLE$ + " ON DISPLAY" 700 REM Terminate if not called from the Menu 710 IF DD.MENU$ <> "" THEN 770 720 COLOR 7,0 : KEY ON : CLS : LOCATE 15,1 730 PRINT "Cannot run the" 740 PRINT TITLE$ 750 PRINT "Program, unless selected from the MENU" 760 END 770 REM OK 1000 REM Produce the first screen 1010 KEY ON : CLS : KEY OFF 1020 REM Draw the outer double box 1030 R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300 1040 REM Find the title location 1050 TITLE.POS = 40 - INT(LEN(TITLE$)/2) 1060 REM Draw the title box 1070 R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500 1080 REM Print the title 1090 LOCATE 4,TITLE.POS : PRINT TITLE$ 1100 LOCATE 5,40-INT(LEN(VERSION$)/2) : PRINT VERSION$; 1230 REM Draw the Copyright box 1240 R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300 1250 REM Print the Copyright 1260 LOCATE 20,40-INT(LEN(COPY1$)/2) : PRINT COPY1$; 1270 LOCATE 21,40-INT(LEN(COPY2$)/2) : PRINT COPY2$; 1280 GOTO 1700 1300 REM subroutine to print a double box 1310 COLOR P 1320 FOR I = R1 + 1 TO R2 - 1 1330 LOCATE I, C1 : PRINT CHR$(186); 1340 LOCATE I, C2 : PRINT CHR$(186); 1350 NEXT I 1360 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205); 1390 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205); 1400 LOCATE R1, C1 : PRINT CHR$(201); 1410 LOCATE R1, C2 : PRINT CHR$(187); 1420 LOCATE R2, C1 : PRINT CHR$(200); 1430 LOCATE R2, C2 : PRINT CHR$(188); 1440 COLOR W 1450 RETURN 1500 REM subroutine to print a single box 1510 COLOR B 1520 FOR I = R1 + 1 TO R2 - 1 1530 LOCATE I, C1 : PRINT CHR$(179); 1540 LOCATE I, C2 : PRINT CHR$(179); 1550 NEXT I 1560 LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196); 1590 LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,196); 1600 LOCATE R1, C1 : PRINT CHR$(218); 1610 LOCATE R1, C2 : PRINT CHR$(191); 1620 LOCATE R2, C1 : PRINT CHR$(192); 1630 LOCATE R2, C2 : PRINT CHR$(217); 1640 COLOR W 1650 RETURN 1700 REM ask user to press a key to continue 1710 LOCATE 25,1 1720 PRINT "Have Data Diskette(s) in Place, then Press any key to continue."; 1730 K$ = INKEY$ : IF K$ = "" THEN 1730 1740 KEY ON : CLS : KEY OFF 2000 REM LISTPER Program Starts Here 2010 OPEN DD.PERS$+"persfile" AS #1 LEN = 256 2020 FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$ 2030 REM Read all records, and print the actual ones 2040 K = 0 2050 KEY ON : CLS : KEY OFF : LOCATE 21,1 2060 PRINT "Printing a List of Records in the Persons File" 2070 GOSUB 2090 2080 GOTO 2140 2090 LPRINT " List of the Records in the Persons File ";DATE$;" ";TIME$ 2100 LPRINT 2110 LPRINT " REC GIVEN NAMES-SURNAME";TAB(50);"BIRTHDATE FATHER MOTHER 2120 LPRINT " --- -------------------";TAB(50);"----------- ------ ------ 2130 RETURN 2140 IF START.PER < 1 THEN START.PER = 1 2150 FOR I = START.PER TO MAX.PER 2160 GET #1, I 2170 LOCATE 23,1 : PRINT "Printing Record:";I 2180 REM Extract information from the file for use 2190 T1! = CVS(F1$) : T1 = T1! 2200 IF T1 < 1 THEN 2370 2210 K = K + 1 2220 T2$ = F2$ 2230 FOR J = 1 TO LEN(F2$)-1 2240 IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1 2250 NEXT J 2260 T3$ = F3$ 2270 FOR J = 1 TO LEN(F3$)-1 2280 IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1 2290 NEXT J 2300 T6! = CVS(F6$) : T6 = T6! 2310 T7! = CVS(F7$) : T7 = T7! 2320 T8$ = F8$ 2330 LPRINT USING "########";T1; 2340 LPRINT " "; LEFT$(T3$+" "+T2$,39); TAB(50); T8$; 2350 LPRINT USING "###### ######";T6, T7 2360 IF K MOD 55 = 0 THEN LPRINT FORM.FEED$;: GOSUB 2090 2370 NEXT I 2380 CLOSE #1 2390 LPRINT FORM.FEED$; 2400 KEY ON : CLS : KEY OFF : LOCATE 21,1 2410 PRINT "End of Program" 2420 RUN DD.MENU$+"menu" 
(.txt)